library(imager)

img <- load.image(system.file("extdata/parrots.png", package="imager"))
gary.img <- grayscale(img)
plot(gary.img)

conv.filter.1 = matrix(c(-1, -1, -1,
                         -1, +8, -1,
                         -1, -1, -1), nrow = 3)

img.matrix = as.matrix(gary.img)

feature.img = matrix(NA, nrow = nrow(img.matrix) - 2, ncol = ncol(img.matrix) - 2)

for (i in 1:nrow(feature.img)) {
  for (j in 1:ncol(feature.img)) {
    sub.img.matrix = img.matrix[0:2+i,0:2+j]
    feature.img[i,j] = sum(sub.img.matrix * conv.filter.1)
  }
}

new.img = as.cimg(feature.img)
plot(new.img)

conv.filter.2 = matrix(c(-1, 0, +1,
                         -2, 0, +2,
                         -1, 0, +1), nrow = 3)

DAT = read.csv("data/train.csv")

#Split data

set.seed(0)
Train.sample = sample(1:nrow(DAT), nrow(DAT)*0.6, replace = FALSE)

Train.X = DAT[Train.sample,-1]/255
Train.Y = DAT[Train.sample,1]
Test.X = DAT[-Train.sample,-1]/255
Test.Y = DAT[-Train.sample,1]

#Display

library(imager)

par(mar=rep(0,4), mfcol = c(4, 4))
for (i in 1:16) {
  plot(NA, xlim = 0:1, ylim = 0:1, xaxt = "n", yaxt = "n", bty = "n")
  img = as.raster(t(matrix(as.numeric(Train.X[i,]), nrow = 28)))
  rasterImage(img, -0.04, -0.04, 1.04, 1.04, interpolate=FALSE)
  text(0.05, 0.95, Train.Y[i], col = "green", cex = 2)
}

Train.X.array = t(Train.X)
dim(Train.X.array) <- c(28, 28, 1, nrow(Train.X))
Test.X.array <- t(Test.X)
dim(Test.X.array) <- c(28, 28, 1, nrow(Test.X))

library(mxnet)

# input
data <- mx.symbol.Variable('data')
# first conv
conv1 <- mx.symbol.Convolution(data=data, kernel=c(5,5), num_filter=20)
relu1 <- mx.symbol.Activation(data=conv1, act_type="relu")
pool1 <- mx.symbol.Pooling(data=relu1, pool_type="max",
                          kernel=c(2,2), stride=c(2,2))
# second conv
conv2 <- mx.symbol.Convolution(data=pool1, kernel=c(5,5), num_filter=50)
relu2 <- mx.symbol.Activation(data=conv2, act_type="relu")
pool2 <- mx.symbol.Pooling(data=relu2, pool_type="max",
                          kernel=c(2,2), stride=c(2,2))
# first fullc
flatten <- mx.symbol.Flatten(data=pool2)
fc1 <- mx.symbol.FullyConnected(data=flatten, num_hidden=500)
relu3 <- mx.symbol.Activation(data=fc1, act_type="relu")

# second fullc
fc2 <- mx.symbol.FullyConnected(data=relu3, num_hidden=10)
# loss
lenet <- mx.symbol.SoftmaxOutput(data=fc2)

mx.set.seed(0)
model_1 = mx.model.FeedForward.create(lenet, X = Train.X.array, y = Train.Y,
                                      ctx = mx.cpu(), num.round = 20, array.batch.size = 100,
                                      learning.rate = 0.05, momentum = 0.9, wd = 0.00001,
                                      eval.metric = mx.metric.accuracy,
                                      epoch.end.callback = mx.callback.log.train.metric(100))

preds = predict(model_1, Test.X.array)
pred.label = max.col(t(preds)) - 1
tab = table(pred.label, Test.Y)
cat("Testing accuracy rate =", sum(diag(tab))/sum(tab))

print(tab)

n.cpu <- 4
device.cpu <- lapply(0:(n.cpu-1), function(i) {mx.cpu(i)})

model_2 = mx.model.FeedForward.create(lenet, X = Train.X.array, y = Train.Y,
                                      ctx = device.cpu, num.round = 1, array.batch.size = 100,
                                      learning.rate = 0.05, momentum = 0.9, wd = 0.00001,
                                      eval.metric = mx.metric.accuracy,
                                      arg.params = model_1$arg.params,
                                      epoch.end.callback = mx.callback.log.train.metric(100))

PARAMS = model_1$arg.params
ls(PARAMS)

Input = Test.X.array[,,,1]
dim(Input) = c(28, 28, 1, 1)
preds = predict(model_1, Input)
pred.label = max.col(t(preds)) - 1

par(mar=rep(0,4))
plot(NA, xlim = 0:1, ylim = 0:1, xaxt = "n", yaxt = "n", bty = "n")
img = as.raster(t(matrix(as.numeric(Input), nrow = 28)))
rasterImage(img, -0.04, -0.04, 1.04, 1.04, interpolate=FALSE)
text(0.05, 0.95, Test.Y[1], col = "green", cex = 2)
text(0.95, 0.95, pred.label, col = "blue", cex = 2)

library(data.table)
library(magrittr)
library(dplyr)
library(plyr)

word.data = fread("data/glove.6B.50d.txt", header = FALSE)

words.ref = word.data %>% select(V1) %>% setDF %>% .[,1] %>% as.character
words.matrix = word.data %>% select(-V1) %>% setDF %>% as.matrix
rownames(words.matrix) = words.ref
dim(words.matrix)

word = "adenocarcinoma"

word.vector = words.matrix[which(words.ref==word),]
other.vectors = words.matrix[which(words.ref!=word),]

Dot_Product = other.vectors %*% word.vector
distance.word = sqrt(sum(word.vector^2))
distance.other = apply(other.vectors, 1, function(x) {sqrt(sum(x^2))})

cos_value = Dot_Product/distance.word/distance.other
cos_value = cos_value[order(cos_value[,1], decreasing = TRUE),]
head(cos_value, 10)

example = "Adenocarcinoma of stomach with peritoneal carcinomatosis and massive ascite, stage IV under bidirection chemotherapy (neoadjuvant intraperitoneal-systemic chemotherapy) with intraperitoneal paclitaxel 120mg (20151126, 20151201) and systemic with Oxalip (20151127) and oral XELOX."

text = tolower(example)
text = gsub("\n", "@@@@@", text, fixed = TRUE)
text = gsub("\r", "@@@@@", text, fixed = TRUE)
text = gsub("[ :,;-]", "@", text)
text = gsub("(", "@", text, fixed = TRUE)
text = gsub(")", "@", text, fixed = TRUE)
text = gsub("/", "@", text, fixed = TRUE)
text = strsplit(text, split = ".", fixed = TRUE)[[1]]
text = paste(text, collapse = "@@@@@")
text = strsplit(text, split = "@", fixed = TRUE)[[1]]

TEXT.ARRAY = matrix(0, nrow = length(text), ncol = 50)
for (i in 1:length(text)) {
  if (text[i]!="") {
    pos = which(words.ref == text[i])
    if (length(pos)==1) {
      TEXT.ARRAY[i,] = words.matrix[pos,]
    }
  }
}

library(imager)
img = TEXT.ARRAY
img[img>2] = 2
img[img<-2] = -2
plot(as.cimg(t(img)))

load("data/ICD10.RData")

Train.X.array = ARRAY[,,1:3000]
dim(Train.X.array) = c(100, 50, 1, 3000)
Train.Y = LABEL[1:3000]

Vald.X.array = ARRAY[,,3001:4000]
dim(Vald.X.array) = c(100, 50, 1, 1000)
Vald.Y = LABEL[3001:4000]

Test.X.array = ARRAY[,,4001:5000]
dim(Test.X.array) = c(100, 50, 1, 1000)
Test.Y = LABEL[4001:5000]

library(mxnet)

get_symbol_textcnn <- function(num_outcome = 1,
                               filter_sizes = 1:5,
                               num_filter = c(40, 30, 15, 10, 5),
                               Seq.length = 100,
                               word.dimation = 50,
                               dropout = 0.5) {
  
  data <- mx.symbol.Variable('data')
  
  concat_lst <- NULL
  
  for (i in 1:length(filter_sizes)) {
    convi <- mx.symbol.Convolution(data = data,
                                   kernel = c(filter_sizes[i], word.dimation),
                                   pad = c(filter_sizes[i]-1, 0),
                                   num_filter = num_filter[i],
                                   name = paste0('conv', i))
    relui <- mx.symbol.Activation(data = convi,
                                  act_type = "relu",
                                  name = paste0('relu', i))
    pooli <- mx.symbol.Pooling(data = relui,
                               pool_type = "max",
                               kernel = c(Seq.length + filter_sizes[i] - 1, 1),
                               stride = c(1, 1),
                               name = paste0('pool', i))
    concat_lst = append(concat_lst, pooli)
  }
  
  concat_lst$num.args = length(filter_sizes)
  
  h_pool = mxnet:::mx.varg.symbol.Concat(concat_lst)
  
  # dropout layer
  
  if (dropout > 0) {
    h_drop = mx.symbol.Dropout(data = h_pool, p = dropout)
  } else {
    h_drop = h_pool
  }
  
  # fully connected layer
  
  cls_weight = mx.symbol.Variable('cls_weight')
  cls_bias = mx.symbol.Variable('cls_bias')
  
  fc = mx.symbol.FullyConnected(data = h_drop,
                                weight = cls_weight,
                                bias = cls_bias,
                                num_hidden = num_outcome)
  lr = mx.symbol.LogisticRegressionOutput(fc, name='lr')
  
  return(lr)
}

my.eval.metric.CE <- mx.metric.custom(
  name = "Cross-Entropy (CE)", 
  function(real, pred) {
    real1 = as.numeric(real)
    pred1 = as.numeric(pred)
    pred1[pred1 <= 1e-6] = 1e-6
    pred1[pred1 >= 1 - 1e-6] = 1 - 1e-6
    return(-mean(real1 * log(pred1) + (1 - real1) * log(1 - pred1), na.rm = TRUE))
  }
)

mx.callback.early.stop <- function(period, logger = NULL, small.value = "good", tolerance = 1e-4) {
  function(iteration, nbatch, env, verbose) {
    if (nbatch %% period == 0 && !is.null(env$metric)) {
      result <- env$metric$get(env$train.metric)
      if (nbatch != 0) {
        if(verbose) {cat(paste0("Batch [", nbatch, "] Train-", result$name, "=", result$value, "\n"))}
      }
      if (!is.null(logger)) {
        if (class(logger) != "mx.metric.logger") {
          stop("Invalid mx.metric.logger.")
        } else {
          logger$train <- c(logger$train, result$value)
          if (!is.null(env$eval.metric)) {
            result <- env$metric$get(env$eval.metric)
            if (nbatch != 0) {cat(paste0("Batch [", nbatch, "] Validation-", result$name, "=", result$value, "\n"))}
            logger$eval <- c(logger$eval, result$value)
          }
        }
      }
    }
    if (!is.null(env$metric)) {
      if (length(logger$train) >= 10) {
        if (!is.null(env$eval.metric)) {TEST.VALUE = round(logger$eval/tolerance)} else {TEST.VALUE = round(logger$train/tolerance)}
        if (small.value=="good") {
          if (mean(tail(TEST.VALUE, 10)) <= mean(tail(TEST.VALUE, 5))) {return(FALSE)}
        } else {
          if (mean(tail(TEST.VALUE, 10)) >= mean(tail(TEST.VALUE, 5))) {return(FALSE)}
        }
      }
    }
    return(TRUE)
  }
}

mx.set.seed(0)

logger = mx.metric.logger$new()

cnn.model = mx.model.FeedForward.create(get_symbol_textcnn(),
                                        X = Train.X.array, y = Train.Y,
                                        eval.data = list(data = Vald.X.array, label = Vald.Y),
                                        ctx = mx.cpu(), num.round = 100,
                                        array.batch.size = 100, learning.rate = 0.05,
                                        momentum = 0.9, wd = 0.00001,
                                        eval.metric = my.eval.metric.CE,
                                        epoch.end.callback = mx.callback.early.stop(100, logger, small.value = "good"))

pred.prob = predict(cnn.model, Test.X.array)
pred.y = pred.prob>0.5
tab = table(Test.Y, pred.y)
cat("Testing accuracy rate =", sum(diag(tab))/sum(tab))

print(tab)